
'-------------------------------------------------
' Hands-On 16-1
' No code in this Hands-On.
' Please follow the instructions in the book
'-------------------------------------------------


'-------------------------------------------------
' Hands-On 16-2
'-------------------------------------------------

Sub AccessViaAutomation()
    Dim objAccess As Access.Application
    Dim strPath As String

    On Error Resume Next

    Set objAccess = GetObject(, "Access.Application.12")
    If objAccess Is Nothing Then
        ' Get a reference to the Access Application object
        Set objAccess = New Access.Application
    End If

    strPath = "C:\Ex07_HandsOn\Northwind 2007.accdb"
  
     ' Open the Employees table in the Northwind database
    With objAccess
        .OpenCurrentDatabase strPath
        .DoCmd.OpenTable "Employees", acViewNormal, acReadOnly
        If MsgBox("Do you want to make the Access " & vbCrLf _
            & "Application visible?", vbYesNo, _
            "Display Access") = vbYes Then
            .Visible = True
            MsgBox "Notice the Access Application icon " _
            & "now appears on the Windows taskbar."
        End If
        ' Close the database and quit Access
        .CloseCurrentDatabase
        .Quit
    End With
    
    Set objAccess = Nothing
End Sub

--------------------------------------------------
' Procedure in the shaded box before Hands-On 16-3
--------------------------------------------------

Sub OpenSecuredDB()
    Static objAccess As Access.Application
    Dim db As DAO.Database
    Dim strDb As String
    
    strDb = "C:\myAccessDb.mdb"
    Set objAccess = New Access.Application
    Set db = objAccess.DBEngine. _
      OpenDatabase(Name:=strDb, _
      Options:=False, _
      ReadOnly:=False, _
      Connect:=";PWD=test")
    With objAccess
        .Visible = True
        .OpenCurrentDatabase strDb
    End With
    db.Close
    
    Set db = Nothing
End Sub


'-------------------------------------------------
' Hands-On 16-3
'-------------------------------------------------

Sub DAO_OpenDatabase(strDbPathName As String)
    Dim db As DAO.Database
    Dim tbl As Variant

    Set db = DBEngine.OpenDatabase(strDbPathName)
        
    MsgBox "There are " & db.TableDefs.Count & _
      " tables in " & strDbPathName & "." & vbCrLf & _
      "View the names in the Immediate window."

    For Each tbl In db.TableDefs
        Debug.Print tbl.Name
    Next
    
    db.Close
    Set db = Nothing
    MsgBox "The database has been closed."
End Sub



'-------------------------------------------------
' Hands-On 16-4
'-------------------------------------------------

Sub ADO_OpenDatabase(strDbPathName)
    Dim con As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim fld As ADODB.Field

    ' Connect with the database
    
    If Right(strDbPathName, 3) = "mdb" Then
        con.Open _
        "Provider=Microsoft.Jet.OLEDB.4.0;" _
        & "Data Source=" & strDbPathName
    ElseIf Right(strDbPathName, 3) = "cdb" Then
        con.Open _
        "Provider = Microsoft.ACE.OLEDB.12.0;" _
         & "Data Source=" & strDbPathName
    Else
        MsgBox "Incorrect filename extension"
        Exit Sub
    End If
    

    ' Open Recordset based on the SQL statement
      rst.Open "SELECT * FROM Employees " & _
        "WHERE City = 'Redmond'", con, _
        adOpenForwardOnly, adLockReadOnly

    ' Print the field values for each
    ' Redmond Employee to the Immediate Window
      Do Until rst.EOF
        For Each fld In rst.Fields
          Debug.Print fld.Name & "=" & fld.Value & vbCrLf
        Next
        rst.MoveNext
      Loop

    ' Close the Recordset and connection with Access
    rst.Close
    con.Close
    
    ' Destroy object variables to reclaim the resources
    Set rst = Nothing
    Set con = Nothing
End Sub


'-------------------------------------------------
' Hands-On 16-5
'-------------------------------------------------

Sub NewDB_DAO()
    Dim db As DAO.Database
    Dim tbl As DAO.TableDef
    Dim strDb As String
    Dim strTbl As String

    On Error GoTo Error_CreateDb_DAO
    strDb = "C:\Ex07_ByExample\ExcelDump.mdb"
    strTbl = "tblStates"
    ' Create a new database named ExcelDump
    Set db = CreateDatabase(strDb, dbLangGeneral)

    ' Create a new table named tblStates
    Set tbl = db.CreateTableDef(strTbl)

    ' Create fields and append them to the Fields collection
    With tbl
      .Fields.Append .CreateField("StateID", dbText, 2)
      .Fields.Append .CreateField("StateName", dbText, 25)
      .Fields.Append .CreateField("StateCapital", dbText, 25)
    End With

    ' Append the new tbl object to the TableDefs
    db.TableDefs.Append tbl
    ' Close the database
    db.Close
    Set db = Nothing
    MsgBox "There is a new database on your hard disk. " _
        & "This database file contains a table " _
        & "named " & strTbl & "." & vbCrLf _
        & "Before you activate this database, please close " _
        & "the Excel application."
Exit_CreateDb_DAO:
    Exit Sub
Error_CreateDb_DAO:
    If Err.Number = 3204 Then
        ' Delete the database file if it
        ' already exists
        Kill strDb
        Resume
    Else
        MsgBox Err.Number & ": " & Err.Description
        Resume Exit_CreateDb_DAO
    End If
End Sub


'-------------------------------------------------
' Hands-On 16-6
'-------------------------------------------------

Dim objAccess As Access.Application ' declare at the module level

Sub DisplayAccessForm()
    Dim strDb As String
    Dim strFrm As String

    strDb = "C:\Ex07_HandsOn\Northwind.mdb"
    strFrm = "Customers"

    Set objAccess = New Access.Application
    With objAccess
        .OpenCurrentDatabase strDb
        .DoCmd.OpenForm strFrm, acNormal
        .DoCmd.Restore
        .Visible = True
    End With
End Sub


'-------------------------------------------------
' Hands-On 16-7
'-------------------------------------------------

' declare at the module level if it's not already there
Dim objAccess As Access.Application 

Sub DisplayAccessReport()
    Dim strDb As String
    Dim strRpt As String
    strDb = "C:\Ex07_HandsOn\Northwind.mdb"
    strRpt = "Products by Category"

    Set objAccess = New Access.Application
    With objAccess
        .OpenCurrentDatabase (strDb)
        .DoCmd.OpenReport strRpt, acViewPreview
        .DoCmd.Maximize
        .Visible = True
    End With
End Sub

' declare at the module level if it's not already there
Dim objAccess As Access.Application

Sub DisplayAccessReport2(strDb As String, strRpt As String)
    Dim objAccess As Access.Application
    Set objAccess = New Access.Application

    With objAccess
        .OpenCurrentDatabase (strDb)
        .DoCmd.OpenReport strRpt, acViewPreview
        .DoCmd.Maximize
        .Visible = True
    End With
End Sub

Sub ShowReport()
    Dim strDb As String
    Dim strRpt As String

    strDb = InputBox("Enter the name of the database (full path): ")
    strRpt = InputBox("Enter the name of the report:")
    Call DisplayAccessReport2(strDb, strRpt)
End Sub


'-------------------------------------------------
' Hands-On 16-8
'-------------------------------------------------

Sub CreateDB_ViaADO()
    Dim cat As ADOX.Catalog
    Set cat = New ADOX.Catalog

    cat.Create "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=C:\Ex07_ByExample\ExcelDump2.accdb;"

    Set cat = Nothing
End Sub


'-------------------------------------------------
' Hands-On 16-9
'-------------------------------------------------

Sub RunAccessQuery(strQryName As String)
    Dim cat As ADOX.Catalog
    Dim cmd As ADODB.Command
    Dim rst As ADODB.Recordset
    Dim i As Integer
    Dim strPath As String

    strPath = "C:\Ex07_HandsOn\Northwind.mdb"

    Set cat = New ADOX.Catalog
    cat.ActiveConnection = _
        "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & strPath

    Set cmd = cat.Views(strQryName).Command
    Set rst = cmd.Execute

    Sheets(2).Select
    For i = 0 To rst.Fields.Count - 1
        Cells(1, i + 1).Value = rst.Fields(i).Name
    Next
    With ActiveSheet
        .Range("A2").CopyFromRecordset rst
        .Range(Cells(1, 1), _
            Cells(1, rst.Fields.Count)).Font.Bold = True
        .Range("A1").Select
    End With

    Selection.CurrentRegion.Columns.AutoFit
    rst.Close

    Set cmd = Nothing
    Set cat = Nothing
End Sub


'-------------------------------------------------
' Hands-On 16-10
'-------------------------------------------------

Sub RunAccessParamQuery()
    Dim cat As ADOX.Catalog
    Dim cmd As ADODB.Command
    Dim rst As ADODB.Recordset
    Dim i As Integer
    Dim strPath As String
    Dim StartDate As String
    Dim EndDate As String

    strPath = "C:\Ex07_HandsOn\Northwind.mdb"
    StartDate = "7/1/96"
    EndDate = "7/31/96"

    Set cat = New ADOX.Catalog
    cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & strPath
    Set cmd = cat.Procedures("Employee Sales by Country").Command

    cmd.Parameters("[Beginning Date]") = StartDate
    cmd.Parameters("[Ending Date]") = EndDate

    Set rst = cmd.Execute

    Sheets.Add
    For i = 0 To rst.Fields.Count - 1
        Cells(1, i + 1).Value = rst.Fields(i).Name
    Next
    With ActiveSheet
        .Range("A2").CopyFromRecordset rst
        .Range(Cells(1, 1), Cells(1, rst.Fields.Count)) _
            .Font.Bold = True
        .Range("A1").Select
    End With
    Selection.CurrentRegion.Columns.AutoFit

    rst.Close
    Set cmd = Nothing
    Set cat = Nothing
End Sub


Sub RunAccessFunction()
    Dim objAccess As Object

    On Error Resume Next
    Set objAccess = GetObject(, "Access.Application")

    ' if no instance of Access is open, create a new one
    If objAccess Is Nothing Then
        Set objAccess = CreateObject("Access.Application")
    End If
    MsgBox "For 1000 Spanish pesetas you will get " & _
        objAccess.EuroConvert(1000, "ESP", "EUR") & _
        " euro dollars. "
    Set objAccess = Nothing
End Sub

'-------------------------------------------------
' Hands-On 16-11
'-------------------------------------------------

Sub GetData_withGetRows()
    Dim db As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim rst As DAO.Recordset
    Dim recArray As Variant
    Dim i As Integer
    Dim j As Integer
    Dim strPath As String
    Dim a As Variant
    Dim countR As Long
    Dim strShtName As String

    strPath = "C:\Ex07_HandsOn\Northwind.mdb"
    strShtName = "Returned records"

    Set db = OpenDatabase(strPath)
    Set qdf = db.QueryDefs("Invoices")
    Set rst = qdf.OpenRecordset

    rst.MoveLast
    countR = rst.RecordCount
    a = InputBox("This recordset contains " & _
        countR & " records." & vbCrLf _
        & "Enter number of records to return: ", _
        "Get Number of Records")

    If a = "" Or a = 0 Then Exit Sub
    If a > countR Then
        a = countR
        MsgBox "The number you entered is too large." & vbCrLf _
            & "All records will be returned."
    End If

    Workbooks.Add
    ActiveWorkbook.Worksheets(1).Name = strShtName
    rst.MoveFirst
        With Worksheets(strShtName).Range("A1")
            .CurrentRegion.Clear
            recArray = rst.GetRows(a)
            For i = 0 To UBound(recArray, 2)
                For j = 0 To UBound(recArray, 1)
                    .Offset(i + 1, j) = recArray(j, i)
                Next j
            Next i
            For j = 0 To rst.Fields.Count - 1
                .Offset(0, j) = rst.Fields(j).Name
                .Offset(0, j).EntireColumn.AutoFit
            Next j
        End With
    db.Close
End Sub


Sub GetData_withGetRows_ADO()
    Dim cat As ADOX.Catalog
    Dim cmd As ADODB.Command
    Dim rst As ADODB.Recordset
    Dim strConnect As String
    Dim recArray As Variant
    Dim i As Integer
    Dim j As Integer
    Dim strPath As String
    Dim a As Variant
    Dim countR As Long
    Dim strShtName As String

    strConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" _
        & "Data Source=C:\Ex07_HandsOn\Northwind 2007.accdb;"
        
    strShtName = "Returned records"

    Set cat = New ADOX.Catalog
    cat.ActiveConnection = strConnect

    Set cmd = cat.Views("Order Summary").Command
    Set rst = New ADODB.Recordset
    rst.Open cmd, , adOpenStatic, adLockReadOnly

    countR = rst.RecordCount
    a = InputBox("This recordset contains " & _
        countR & " records." & vbCrLf _
        & "Enter number of records to return: ", _
        "Get Number of Records")

    If a = "" Or a = 0 Then Exit Sub
    If a > countR Then
        a = countR
        MsgBox "The number you entered is too large." & vbCrLf _
            & "All records will be returned."
    End If

    Workbooks.Add
    ActiveWorkbook.Worksheets(1).Name = strShtName
    rst.MoveFirst
        With Worksheets(strShtName).Range("A1")
            .CurrentRegion.Clear
            recArray = rst.GetRows(a)
            For i = 0 To UBound(recArray, 2)
                For j = 0 To UBound(recArray, 1)
                    .Offset(i + 1, j) = recArray(j, i)
                Next j
            Next i
            For j = 0 To rst.Fields.Count - 1
                .Offset(0, j) = rst.Fields(j).Name
                .Offset(0, j).EntireColumn.AutoFit
            Next j
        End With

    Set rst = Nothing
    Set cmd = Nothing
    Set cat = Nothing
End Sub


'-------------------------------------------------
' Hands-On 16-12
'-------------------------------------------------

Sub GetProducts()
    Dim conn As New ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim strPath As String

    strPath = "C:\Ex07_HandsOn\Northwind.mdb"

    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
        & "Data Source=" & strPath & ";"
    conn.CursorLocation = adUseClient

    ' Create a Recordset from all the records
    ' in the Products table

    Set rst = conn.Execute(CommandText:="Products", _
        Options:=adCmdTable)

    rst.MoveFirst

    ' transfer the data to Excel
    ' get the names of fields first
    With Worksheets("Sheet3").Range("A1")
        .CurrentRegion.Clear
        For j = 0 To rst.Fields.Count - 1
            .Offset(0, j) = rst.Fields(j).Name
        Next j
        .Offset(1, 0).CopyFromRecordset rst
        .CurrentRegion.Columns.AutoFit
    End With
    rst.Close
    conn.Close

    Set rst = Nothing
    Set conn = Nothing
End Sub


'-------------------------------------------------
' Hands-On 16-13
'-------------------------------------------------

Sub ExportData()
    Dim objAccess As Access.Application
    Set objAccess = CreateObject("Access.Application")

    objAccess.OpenCurrentDatabase filepath:= _
        "C:\Ex07_HandsOn\Northwind.mdb"

    objAccess.DoCmd.TransferSpreadsheet _
        TransferType:=acExport, _
        SpreadsheetType:=acSpreadsheetTypeExcel12, _
        TableName:="Shippers", _
        Filename:="C:\Ex07_ByExample\Shippers.xls", _
        HasFieldNames:=True, _
        Range:="Sheet1"

    objAccess.Quit
    Set objAccess = Nothing
End Sub


Sub OpenAccessDatabase()
   On Error Resume Next
   Workbooks.OpenDatabase _
     Filename:="C:\Ex07_HandsOn\Northwind.mdb"
   Exit Sub
End Sub


'-------------------------------------------------
' Hands-On 16-14
'-------------------------------------------------

Sub CountCustomersByCountry()
    On Error Resume Next

    Workbooks.OpenDatabase _
        Filename:="C:\Ex07_HandsOn\Northwind.mdb", _
        CommandText:="Select * from Customers", _
        CommandType:=xlCmdSql, _
        BackgroundQuery:=True, _
        ImportDataAs:=xlPivotTableReport
    Exit Sub
End Sub


'-------------------------------------------------
' Hands-On 16-15
'-------------------------------------------------

Sub CreateTextFile()
    Dim strPath As String
    Dim conn As New ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim strData As String
    Dim strHeader As String
    Dim strSQL As String
    Dim fld As Variant

    strPath = "C:\Ex07_HandsOn\Northwind.mdb"

    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
        & "Data Source=" & strPath & ";"

    conn.CursorLocation = adUseClient

    strSQL = "SELECT * FROM Products WHERE UnitPrice > 50"
    Set rst = conn.Execute(CommandText:=strSQL, Options:=adCmdText)

    ' save the recordset as a tab-delimited file
    strData = rst.GetString(StringFormat:=adClipString, _
                ColumnDelimeter:=vbTab, RowDelimeter:=vbCr, _
                nullExpr:=vbNullString)
    
    For Each fld In rst.Fields
        strHeader = strHeader + fld.Name & vbTab
    Next

    Open "C:\Ex07_ByExample\ProductsOver50.txt" For Output As #1
    Print #1, strHeader
    Print #1, strData
    Close #1

    rst.Close
    conn.Close

    Set rst = Nothing
    Set conn = Nothing
End Sub


Sub CreateTextFile2()
    Dim conn As New ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim strPath As String
    Dim strData As String
    Dim strHeader As String
    Dim strSQL As String
    Dim fso As Object
    Dim myFile As Object
    Dim fld As Variant

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set myFile = fso.CreateTextFile( _
       "C:\Ex07_ByExample\ProductsOver20.txt", True)

    strPath = "C:\Ex07_HandsOn\Northwind 2007.accdb"

    conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
        & "Data Source=" & strPath & ";"
    conn.CursorLocation = adUseClient
    strSQL = "SELECT * FROM Products WHERE [List Price] > 20"
 
    Set rst = conn.Execute(CommandText:=strSQL, Options:=adCmdText)

    ' save the recordset as a tab-delimited file
    strData = rst.GetString(StringFormat:=adClipString, _
                ColumnDelimeter:=vbTab, RowDelimeter:=vbCr, _
                nullExpr:=vbNullString)
                
    For Each fld In rst.Fields
        strHeader = strHeader + fld.Name & vbTab
    Next
    With myFile
        .WriteLine strHeader
        .WriteLine strData
        .Close
    End With
End Sub


'-------------------------------------------------
' Hands-On 16-16
'-------------------------------------------------

Sub CreateQueryTable()
    Dim myQryTable As Object
    Dim myDb As String
    Dim strConn As String
    Dim Dest As Range
    Dim strSQL As String

    myDb = "C:\Ex07_HandsOn\Northwind.mdb"
    strConn = "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;" _
        & "Data Source=" & myDb & ";"

    Workbooks.Add
    Set Dest = Worksheets(1).Range("A1")
    Sheets(1).Select
    strSQL = "SELECT * FROM Products WHERE UnitPrice > 20"
    Set myQryTable = ActiveSheet.QueryTables.Add(strConn, _
            Dest, _
            strSQL)
    With myQryTable
        .RefreshStyle = xlInsertEntireRows
        .Refresh False
    End With
End Sub

'-------------------------------------------------
' Hands-On 16-17
'-------------------------------------------------

Sub ChartData_withADO()
    Dim conn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim mySheet As Worksheet
    Dim recArray As Variant
    Dim strQueryName As String
    Dim i As Integer
    Dim j As Integer

    strQueryName = "Category Sales for 1997"

    ' Connect with the database
    conn.Open _
        "Provider=Microsoft.Jet.OLEDB.4.0;" _
        & "Data Source=C:\Ex07_HandsOn\Northwind.mdb;"

    ' Open Recordset based on the SQL statement
        rst.Open "SELECT * FROM [" & strQueryName & "]", conn, _
        adOpenForwardOnly, adLockReadOnly

    Workbooks.Add
    Set mySheet = Worksheets("Sheet2")
    With mySheet.Range("A1")
        recArray = rst.GetRows()
        For i = 0 To UBound(recArray, 2)
            For j = 0 To UBound(recArray, 1)
                .Offset(i + 1, j) = recArray(j, i)
            Next j
        Next i
        For j = 0 To rst.Fields.Count - 1
            .Offset(0, j) = rst.Fields(j).Name
            .Offset(0, j).EntireColumn.AutoFit
        Next j
    End With

    rst.Close
    conn.Close
    Set rst = Nothing
    Set conn = Nothing

    mySheet.Activate
    Charts.Add
    ActiveChart.ChartType = xl3DColumnClustered
    ActiveChart.SetSourceData _
        Source:=mySheet.Cells(1, 1).CurrentRegion, _
        PlotBy:=xlRows
    ActiveChart.Location Where:=xlLocationAsObject, _
        Name:=mySheet.Name

    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = strQueryName
        .Axes(xlCategory).HasTitle = True
        .Axes(xlCategory).AxisTitle.Characters.Text = ""
        .Axes(xlValue).HasTitle = True
        .Axes(xlValue).AxisTitle. _
            Characters.Text = mySheet.Range("B1") & "($)"
        .Axes(xlValue).AxisTitle.Orientation = xlUpward
    End With
End Sub


'-------------------------------------------------
' Hands-On 16-18
'-------------------------------------------------

Sub LinkExcel_ToAccess()
    Dim objAccess As Access.Application
    Dim strTableName As String
    Dim strBookName As String
    Dim strPath As String

    strPath = ActiveWorkbook.Path
    strBookName = strPath & "\Practice_Excel16.xlsm"
    strName = "Linked_ExcelSheet"

    Set objAccess = New Access.Application

    With objAccess
      .OpenCurrentDatabase "C:\Ex07_HandsOn\Northwind 2007.accdb"
      .DoCmd.TransferSpreadsheet acLink, _
               acSpreadsheetTypeExcel12Xml, _
               strName, strBookName, True, "mySheet!A1:D7"
      .DoCmd.OpenTable strName, acViewNormal, acReadOnly
    End With
End Sub


'-------------------------------------------------
' Hands-On 16-19
'-------------------------------------------------

Sub AccessTbl_From_ExcelData()
    Dim conn As ADODB.Connection
    Dim cat As ADOX.Catalog
    Dim myTbl As ADOX.Table
    Dim rstAccess As ADODB.Recordset
    Dim rowCount As Integer
    Dim i As Integer

    On Error GoTo ErrorHandler

    ' connect to Access using ADO
    Set conn = New ADODB.Connection
    conn.Open "Provider = Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source = C:\Ex07_HandsOn\Northwind.mdb;"

    ' create an empty Access table
    Set cat = New Catalog
    cat.ActiveConnection = conn
    Set myTbl = New ADOX.Table
    myTbl.Name = "TableFromExcel"
    cat.Tables.Append myTbl

    ' add fields (columns) to the table
    With myTbl.Columns
        .Append "School No", adVarWChar, 7
        .Append "Equipment Type", adVarWChar, 15
        .Append "Serial Number", adVarWChar, 15
        .Append "Manufacturer", adVarWChar, 20
    End With
    Set cat = Nothing

    MsgBox "The table structure was created."

    ' open a recordset based on the newly created
    ' Access table

    Set rstAccess = New ADODB.Recordset
    With rstAccess
        .ActiveConnection = conn
        .CursorType = adOpenKeyset
        .LockType = adLockOptimistic
        .Open myTbl.Name
    End With

    ' now transfer data from Excel spreadsheet range

    With Worksheets("mySheet")
        rowCount = Range("A2:D7").Rows.Count

        For i = 2 To rowCount + 1
            With rstAccess
                .AddNew    ' add a new record to an Access table
                .Fields("School No") = Cells(i, 1).Text
                .Fields("Equipment Type") = Cells(i, 2).Value
                .Fields("Serial Number") = Cells(i, 3).Value
                .Fields("Manufacturer") = Cells(i, 4).Value
                .Update    ' update the table record
            End With
        Next i
    End With

    MsgBox "Data from an Excel spreadsheet was loaded into the table."

    ' close the Recordset and Connection object and remove them
    ' from memory
    rstAccess.Close
    conn.Close
    Set rstAccess = Nothing
    Set conn = Nothing

    MsgBox "Open the Northwind database to view the table."
AccessTbl_From_ExcelDataExit:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ": " & Err.Description
    Resume AccessTbl_From_ExcelDataExit
End Sub


